home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / CON-03A.ZIP / FUNCT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-16  |  3KB  |  143 lines
  1. unit funct;
  2.  
  3. interface
  4.  
  5. function fileexists(filename: string): boolean;
  6. procedure send_ansi(ansi : string);
  7. function strupper(stingy : string) : string;
  8. function grabstring : string;
  9. function lengthstring(len : integer) : string;
  10. implementation
  11.  
  12. uses crt,
  13.      comms,
  14.      dos;
  15.  
  16. var
  17.   counter       : integer;
  18. function fileexists(filename: string): boolean;
  19. var
  20.   a             : file;
  21. begin
  22.  {$I-}
  23.  Assign(a, FileName);
  24.  FileMode := 0;
  25.  Reset(a);
  26.  Close(a);
  27.  {$I+}
  28.  FileExists := (IOResult = 0) and (FileName <> '');
  29. end;
  30.  
  31.  
  32. procedure send_ansi(ansi: string);
  33. var
  34.   ch            : char;
  35.   f             : text;
  36. begin
  37.   assign(f,'text\'+ansi);
  38.   reset(f);
  39.   repeat
  40.     read(f,ch);
  41.     sc(ch);
  42.     until eof(f);
  43.     close(f)
  44. end;
  45.  
  46. function strupper(stingy : string) : string;
  47.  
  48. begin
  49.   for counter:=1 to length(stingy) do stingy[counter]:=upcase(stingy[counter]);
  50.   strupper:=stingy;
  51. end;
  52.  
  53. function grabstring : string;
  54. var
  55.   letters       : integer;
  56.   ch            : char;
  57. begin
  58.   letters:=0;
  59.   repeat
  60.     ch:=readkey;
  61.     if (ch<>#13) and (ch<>#8) then begin
  62.       inc(letters);
  63.       grabstring[letters]:=ch;
  64.       write(ch);
  65.    end else if ch=#8 then begin dec(letters);
  66.     write(ch);
  67.     write(' ');
  68.     inc(letters);
  69.     dec(letters);
  70.     write(ch);
  71.   end;
  72.   if ch=#13 then writeln;
  73.   until ch=#13;
  74.   grabstring[0]:=chr(letters);
  75. end;
  76.  
  77. function lengthstring(len : integer) : string;
  78. var
  79.   letters       : integer;
  80.   ch            : char;
  81.   c             : string;
  82. begin
  83.   letters:=0;
  84.   repeat
  85.     ch:=readkey;
  86.     if (ch<>#13) and (ch<>#8) then begin
  87.       if letters<=len then begin
  88.         inc(letters);
  89.         lengthstring[letters]:=ch;
  90.         write(ch);
  91.       end
  92.    end else if ch=#8 then begin
  93.      if letters>=1 then begin
  94.      dec(letters);
  95.      write(ch);
  96.      write(' ');
  97.      inc(letters);
  98.      dec(letters);
  99.      write(ch);
  100.   end;
  101.   end;
  102.  { if (ch=#8) {and (letters<>0) then begin
  103.     dec(letters);
  104.     write(ch);
  105.     if letters<=0 then
  106.  
  107.   end; }
  108.   if ch=#13 then writeln;
  109.   until ch=#13;
  110.   lengthstring[0]:=chr(letters);
  111. end;
  112.  
  113.  
  114.  
  115. (*function lengthstring(len : integer) : string;
  116. var
  117.   letters       : integer;
  118.   ch            : char;
  119.   length        : integer;
  120. begin
  121.   counter:=0;
  122.   letters:=0;
  123.   repeat
  124.     ch:=readkey;
  125.     if (ch<>#13) and (ch<>#8) then begin
  126.     if length<=len then begin
  127.       inc(length);
  128.       inc(letters);
  129.       lengthstring[letters]:=ch;
  130.       write(ch);
  131.   end
  132.   end else if ch=#8 then begin
  133.     dec(letters,length);
  134.     write(' ');
  135.     write(ch);
  136.   end;
  137.   if ch=#13 then writeln;
  138.   until ch=#13;
  139.   lengthstring[0]:=chr(letters);
  140. end;
  141.  
  142. *)
  143. end.